home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE18 / CLINIC / SPLITTER.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-10-14  |  4.4 KB  |  181 lines
  1. unit Splitter;
  2.  
  3. interface
  4.  
  5. uses
  6.   WinProcs, WinTypes, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ExtCtrls;
  8.  
  9. type
  10.   TOrientation = (soHorizontal, soVertical);
  11.  
  12.   TSplitter = class(TCustomPanel)
  13.   private
  14.     FForm: TForm;
  15.     FSplitControl, FSizeTarget, FTargetControl: TControl;
  16.     FVertical: Boolean;
  17.     FOrientation: TOrientation;
  18.     FSplit: TPoint;
  19.     function GetSizing: Boolean;
  20.     procedure DrawSizingLine;
  21.   protected
  22.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  23.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  24.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  25.     procedure SetOrientation(Value: TOrientation);
  26.     procedure SetParent(AParent: TWinControl); override;
  27.   public
  28.     constructor Create(AOwner: TComponent); override;
  29.     procedure BeginSizing(ASplitControl, ATargetControl: TControl);
  30.     procedure ChangeSizing(X, Y: Integer);
  31.     procedure EndSizing;
  32.     property Sizing: Boolean read GetSizing;
  33.   published
  34.     property Align;
  35.     property Orientation: TOrientation read FOrientation write SetOrientation default soVertical;
  36.     property TargetControl: TControl read FTargetControl write FTargetControl;
  37.   end;
  38.  
  39. procedure Register;
  40.  
  41. implementation
  42.  
  43. function CToC(C1, C2: TControl; P: TPoint): TPoint;
  44. begin
  45.   Result := C1.ScreenToClient(C2.ClientToScreen(P));
  46. end;
  47.  
  48. procedure TSplitter.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  49. begin
  50.   if (Button = mbLeft) and (Shift = [ssLeft]) and (TargetControl <> nil) then
  51.     BeginSizing(Self, TargetControl);
  52. end;
  53.  
  54. procedure TSplitter.MouseMove(Shift: TShiftState; X, Y: Integer);
  55. begin
  56.   if Sizing then ChangeSizing(X, Y);
  57. end;
  58.  
  59. procedure TSplitter.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  60. begin
  61.   if Sizing then EndSizing;
  62. end;
  63.  
  64. procedure TSplitter.SetOrientation(Value: TOrientation);
  65. begin
  66.   if FOrientation <> Value then
  67.   begin
  68.     FOrientation := Value;
  69.     BevelOuter := bvNone;
  70.     Caption := '';
  71.     case Value of
  72.       soHorizontal:
  73.       begin
  74.         Align := alTop;
  75.         Cursor := crVSplit;
  76.         Height := 2;
  77.       end;
  78.       soVertical:
  79.       begin
  80.         Align := alLeft;
  81.         Cursor := crHSplit;
  82.         Width := 2;
  83.       end;
  84.     end;
  85.   end;
  86. end;
  87.  
  88. procedure TSplitter.SetParent(AParent: TWinControl);
  89. begin
  90.   inherited SetParent(AParent);
  91. end;
  92.  
  93. constructor TSplitter.Create(AOwner: TComponent);
  94. begin
  95.   inherited Create(AOwner);
  96.   FForm := AOwner as TForm;
  97.   Orientation := soVertical;
  98. end;
  99.  
  100. function TSplitter.GetSizing: Boolean;
  101. begin
  102.   Result := Assigned(FSplitControl);
  103. end;
  104.  
  105. procedure TSplitter.DrawSizingLine;
  106. var
  107.   P: TPoint;
  108. begin
  109.   P := CToC(FForm, FSplitControl, FSplit);
  110.   with FForm.Canvas do
  111.   begin
  112.     MoveTo(P.X, P.Y);
  113.     if FVertical then
  114.       LineTo(CToC(FForm, FSplitControl, Point(FSplitControl.Width, 0)).X, P.Y)
  115.     else
  116.       LineTo(P.X, CToC(FForm, FSplitControl, Point(0, FSplitControl.Height)).Y)
  117.   end;
  118. end;
  119.  
  120. procedure TSplitter.BeginSizing(ASplitControl, ATargetControl: TControl);
  121. begin
  122.   FSplitControl := ASplitControl;
  123.   FSizeTarget := ATargetControl;
  124.   SetCaptureControl(FSplitControl);
  125.   FVertical := ASplitControl.Width > ASplitControl.Height;
  126.   if FVertical then
  127.     FSplit := Point(0, ASplitControl.Top)
  128.   else
  129.     FSplit := Point(ASplitControl.Left, 0);
  130.   FForm.Canvas.Handle := GetDCEx(FForm.Handle, 0,
  131.     DCX_CACHE or DCX_CLIPSIBLINGS or DCX_LOCKWINDOWUPDATE);
  132.   with FForm.Canvas do
  133.   begin
  134.     Pen.Color := clWhite;
  135.     if FVertical then
  136.       Pen.Width := ASplitControl.Height
  137.     else
  138.       Pen.Width := ASplitControl.Width;
  139.     Pen.Mode := pmXOR;
  140.   end;
  141.   DrawSizingLine;
  142. end;
  143.  
  144. procedure TSplitter.ChangeSizing(X, Y: Integer);
  145. begin
  146.   DrawSizingLine;
  147.   if FVertical then
  148.     FSplit.Y := Y
  149.   else
  150.     FSplit.X := X;
  151.   DrawSizingLine;
  152. end;
  153.  
  154. procedure TSplitter.EndSizing;
  155. var
  156.   DC: HDC;
  157.   P: TPoint;
  158. begin
  159.   DrawSizingLine;
  160.   P := CToC(FSizeTarget, FSplitControl, FSplit);
  161.   SetCaptureControl(nil);
  162.   FSplitControl := nil;
  163.   with FForm do
  164.   begin
  165.     DC := Canvas.Handle;
  166.     Canvas.Handle := 0;
  167.     ReleaseDC(Handle, DC);
  168.   end;
  169.   if FVertical then
  170.     FSizeTarget.Height := P.Y
  171.   else
  172.     FSizeTarget.Width  := P.X;
  173. end;
  174.  
  175. procedure Register;
  176. begin
  177.   RegisterComponents('Samples', [TSplitter]);
  178. end;
  179.  
  180. end.
  181.